unit Mdibkgnd;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs;

type
  TMDIBackgroundStyle = (mbsNormal, mbsMosaic, mbsCentered, mbsStretched);
  TMDIBackground = class(TComponent)
  private
    { Private declarations }
    FNewWinProc      : TFarProc;
    FPrevWinProc     : TFarProc;
    FWindowHandle    : HWND;
    FPicture         : TPicture;
    FStyle           : TMDIBackgroundStyle;
    FEdge            : boolean;
    procedure DrawImage( dc: THandle );
    procedure WndProc(var Msg: TMessage);
    procedure SetPicture(Value: TPicture);
    procedure Change;
    procedure PictureChanged(Sender: TObject);
    procedure SetStyle( s: TMDIBackgroundStyle );
    procedure SetEdge( e: boolean );
    procedure InstallHook;
    procedure UninstallHook;
  protected
    { Protected declarations }
    {procedure Loaded; override;}
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CheckHookChange;
  published
    { Published declarations }
    property Picture: TPicture read FPicture write SetPicture;
    property Style: TMDIBackgroundStyle read FStyle write SetStyle;
    property Edge: boolean read FEdge write SetEdge;
  end;

procedure Register;

implementation

{const
  WS_EX_WINDOWEDGE = $100;
  WS_EX_CLIENTEDGE = $200;}

procedure Register;
begin
  RegisterComponents('DCF', [TMDIBackground]);
end;

procedure TMDIBackground.InstallHook;
begin
  TForm(Owner).HandleNeeded;
  FWindowHandle := TForm(Owner).ClientHandle;
  if FWindowHandle=0 then exit;
  //if FWindowHandle=0 then FWindowHandle := TForm(AOwner).Handle;
  {SetWindowLong(FWindowHandle,GWL_EXSTYLE,GetWindowLong(FWindowHandle,GWL_EXSTYLE) or WS_EX_CLIENTEDGE);}
  FPicture.OnChange := PictureChanged;
  FNewWinProc := MakeObjectInstance(WndProc);
  FPrevWinProc := TFarProc(GetWindowLong(FWindowHandle,GWL_WNDPROC));
  SetWindowLong(FWindowHandle,GWL_WNDPROC,longint(FNewWinProc));
end;

procedure TMDIBackground.UninstallHook;
begin
  if FWindowHandle=0 then exit;
  SetWindowLong(FWindowHandle,GWL_WNDPROC,longint(FPrevWinProc));
  FreeObjectInstance(FNewWinProc);
end;

procedure TMDIBackground.CheckHookChange;
begin
  if (FWindowHandle=0) or (FWindowHandle=TForm(Owner).ClientHandle) then exit;
  UninstallHook;
  InstallHook;
  Change;
end;

constructor TMDIBackground.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPicture := TPicture.Create;
  FStyle := mbsNormal;
  FEdge  := false;
  InstallHook;
end;

{procedure TMDIBackground.Loaded;
var
  f : longint;
begin
  inherited Loaded;
  if FWindowHandle=0 then exit;
  if FEdge then f := GetWindowLong(FWindowHandle,GWL_EXSTYLE) or WS_EX_CLIENTEDGE
           else f := GetWindowLong(FWindowHandle,GWL_EXSTYLE) and not WS_EX_CLIENTEDGE;
  SetWindowLong(FWindowHandle,GWL_EXSTYLE,f);
end;}

destructor TMDIBackground.Destroy;
begin
  UninstallHook;
  FPicture.Free;
  inherited Destroy;
end;

procedure TMDIBackground.Change;
begin
  if FWindowHandle<>0 then InvalidateRect(FWindowHandle,nil,true);
end;

procedure TMDIBackground.SetStyle( s: TMDIBackgroundStyle );
begin
  FStyle := s;
  Change;
end;

procedure TMDIBackground.SetEdge( e: boolean );
var
  f : longint;
begin
  if e=FEdge then exit;
  FEdge := e;
  if FWindowHandle=0 then exit;
  if FEdge then f := GetWindowLong(FWindowHandle,GWL_EXSTYLE) or WS_EX_CLIENTEDGE
           else f := GetWindowLong(FWindowHandle,GWL_EXSTYLE) and not WS_EX_CLIENTEDGE;
  SetWindowLong(FWindowHandle,GWL_EXSTYLE,f);
  SetWindowPos(FWindowHandle,0,0,0,0,0,SWP_DRAWFRAME+SWP_NOMOVE+SWP_NOSIZE+SWP_NOACTIVATE);
  {Change;}
end;

procedure TMDIBackground.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
  Change;
end;

procedure TMDIBackground.PictureChanged(Sender: TObject);
begin
  Change;
end;

procedure TMDIBackground.DrawImage( dc: THandle );
var
  x,y,
  ox,oy,
  cw,ch : integer;
  r     : TRect;
begin
  if FPicture.Graphic=nil then exit;
  with TForm(Owner) do
  begin
    Canvas.Handle := dc;
    case FStyle of
      mbsNormal:
        Canvas.Draw(0,0,FPicture.Graphic);
      mbsStretched:
        begin
          GetClientRect(FWindowHandle,r);
          Canvas.StretchDraw(r,FPicture.Graphic);
        end;
      mbsCentered:
        begin
          GetClientRect(FWindowHandle,r);
          if FPicture.Graphic.Height<(r.Bottom-r.Top+1) then
            y := ((r.Bottom-r.Top+1)-FPicture.Graphic.Height) div 2
          else y := 0;
          if FPicture.Graphic.Width<(r.Right-r.Left+1) then
            x := ((r.Right-r.Left+1)-FPicture.Graphic.Width) div 2
          else x := 0;
          Canvas.Draw(x,y,FPicture.Graphic);
        end;
      mbsMosaic:
        begin
          GetClientRect(FWindowHandle,r);
          ch := r.Bottom-r.Top+1;
          cw := r.Right-r.Left+1;
          ox := 0; oy := 0;
          repeat
            Canvas.Draw(ox,oy,FPicture.Graphic);
            inc(ox,FPicture.Graphic.Width);
            if ox>cw then
            begin
              ox := 0;
              inc(oy,FPicture.Graphic.Height);
            end;
          until oy>ch;
        end;
    end;
    Canvas.Handle := 0;
  end;
end;

procedure TMDIBackground.WndProc(var Msg: TMessage);
begin
  with Msg do
    case Msg of
      WM_ERASEBKGND:
        begin
          if (FPicture.Graphic=nil) or (FStyle=mbsNormal) or (FStyle=mbsCentered) then
            CallWindowProc(FPrevWinProc, FWindowHandle, Msg, wParam, lParam);
          DrawImage(wParam);
          Result := 1;
        end;
      WM_HSCROLL, WM_VSCROLL:
        begin
          Result := CallWindowProc(FPrevWinProc, FWindowHandle, Msg, wParam, lParam);
          if wParam<>SB_THUMBTRACK then
            InvalidateRect(FWindowHandle,nil,true);
        end;
      WM_SIZE:
        begin
          Result := CallWindowProc(FPrevWinProc, FWindowHandle, Msg, wParam, lParam);
          InvalidateRect(FWindowHandle,nil,true);
        end;
    else Result := CallWindowProc(FPrevWinProc, FWindowHandle, Msg, wParam, lParam);
    end;
end;

end.
